Cleaning with regular expressions

Using regular expressions to parse and clean text is an important skill when dealing with text data. Let’s take a look at the data to see what we need to clean by printing the head, or first 6 lines, of the text column - the raw text from the tweets we downloaded.

head(unique(tweets_df$text),10)

##  [1] "@NicArt24 @Jordan_Sather_ No additional abortions need to be performed to continue creating the vaccine."                                                                                                                                                                                                                          
##  [2] "@Jordan_Sather_ The cells were obtained more than 50 years ago, as a result of elective abortions — and today the cells are more than three generations removed from their origin. https://t.co/6T8qxdKkW3"                                                                                                                        
##  [3] "Sad but true. Thanks anti-vaxers! #antivax #VaccinesWork #VaccinateYourKids #science https://t.co/h2N8Y29Im3"                                                                                                                                                                                                                      
##  [4] "Gizmo, a 10-year-old male Rex cat, came in despite the weather for his annual exam and vaccines. Great job Gizmo! Good health takes priority.  #rexcat #bothellpethosp #catsofinstagram #catsoftwitter #meow #vetmed #vettechs #animalspnw https://t.co/jJpkAqBu4z"                                                                
##  [5] "@DarlaShine My children’s daycare director received the polio vaccine in the 70’s. Ended up getting it as a result. She has no feeling or movement in her legs and has to use crutches. Yet.....she still requires every child to be fully vaccinated. Bc she’s smart and knows death is worse. \U0001f64c\U0001f3fb"              
##  [6] "@markgongloff @DarlaShine My children’s daycare director received the polio vaccine in the 70’s. Ended up getting it as a result. She has no feeling or movement in her legs and has to use crutches. Yet.....she still requires every child to be fully vaccinated. Bc she’s smart and knows death is worse. \U0001f64c\U0001f3fb"
##  [7] "Deliberate disinformation is behind a massive measles outbreak in Washington https://t.co/cJYbbSjYtK https://t.co/zUSYZuAO07"                                                                                                                                                                                                      
##  [8] "@FO7935 @Spacebunny21 @Viol3t Why are you even here except to be a advocate for chemical cocktails called vaccines.  If you have pumped your children full of them (actually child abuse), then wtf difference does it make if I choose to not to? If they work, your kids are \"safe\"."                                          
##  [9] "The CDC declared that #Measles had been eliminated in the U.S. 19 years ago – but right now, there is an outbreak in 10 states. \n@NBCNews Medical Contributor @DrNatalieTV joins @SRuhle and @AliVelshi to discuss everything you need to know.\n \nhttps://t.co/MRxb4bkoHy"                                                      
## [10] "Sharyl Attkisson and measles vaccine math – wrong in so many ways https://t.co/vSic7TtNXX Via @skepticalraptor"

From this small peak at the data, we can already see that there are a lot of strings that are not real words. We should remove text that does not help and, in fact, may hinder our analysis. For example, we observe lots of links (“https…”) and UTF characters (“\U000…”) that aren’t giving us any insightful information.

To do this, first we create a string named pat (short for pattern) that contains regular expression or “regex” patterns that match with various unwanted characters or phrases.

pat <- "[\r\n]|&amp.|@.*?[ \t\r\n]|@.*?$|https:.*[ \t\r\n]|https:.*$|[^[:alpha:][ \t\r\n]?&/\\-#.']"

Note that the “|” character separates each pattern the string. For example, the first pattern [\r\n] matches with newline characters, and is followed by a “|” to signify the end of that regular expression.

Let’s break down each of the strings in pat and explain what text it is meant to match with

Let’s break down one of the above patterns, @.*?[ \t\r\n], to see how regular expressions work.

First, @ simply matches with the @ sign, the beginning of tagging a user on Twitter. In regular expression “.” can match with any character except for newline \n. The “*” character matches 0 or more of the previous character, which in the case below is the “.” or any character. So now we have matched with anything beginning with @. The “?” quantifier is non-greedy, meaning it matches as few characters as possible. We want to include this so that we remove the minimum amount of text and thus only the username tag. We stop removing text when we reach a space, tab, carriage return or newline character, [ \t\r\n]. Thus, @.*?[ \t\r\n] matches with any username that is retweeted or tagged.

Now we will remove the string that match with these patterns with str_replace_all. It checks for matches with every seperate pattern in pat and looks for repeats of any pattern (hence, the addition of _all. Each match is replaced with an empty string, "" and thus the unwanted string is removed.

We replace the tweets_df columns text and retweet_text with the cleaned versions of the columns by using mutate. Then we print the head of the text column to view our changes.

tweets_df <- tweets_df %>% 
  mutate(text = str_replace_all(text, pattern = pat, "")) %>%
  mutate(retweet_text = str_replace_all(retweet_text, pattern = pat, "")) %>%
  
  mutate(text = str_replace_all(text, pattern = "  ", " ")) %>%
  mutate(retweet_text = str_replace_all(retweet_text, pattern = "  ", " "))

head(unique(tweets_df$text))

## [1] "No additional abortions need to be performed to continue creating the vaccine."                                                                                                                                                                                                 
## [2] "The cells were obtained more than years ago as a result of elective abortions and today the cells are more than three generations removed from their origin. "                                                                                                                  
## [3] "Sad but true. Thanks anti-vaxers #antivax #VaccinesWork #VaccinateYourKids #science "                                                                                                                                                                                           
## [4] "Gizmo a -year-old male Rex cat came in despite the weather for his annual exam and vaccines. Great job Gizmo Good health takes priority. #rexcat #bothellpethosp #catsofinstagram #catsoftwitter #meow #vetmed #vettechs #animalspnw "                                          
## [5] "My childrens daycare director received the polio vaccine in the s. Ended up getting it as a result. She has no feeling or movement in her legs and has to use crutches. Yet.....she still requires every child to be fully vaccinated. Bc shes smart and knows death is worse. "
## [6] "Deliberate disinformation is behind a massive measles outbreak in Washington "

Now that the raw tweet text is clean, let’s start manipulating the tweets with natural language processing techniques to gain insight about our data.

The tidy text and NLP

The tidy text format is using one-token-per-row in our dataframe. In short, tokens in natural language processing are words. To be technical, you could say a token is a list of characters between two spaces. Tokenization is the process of breaking up a string, paragraph, or document into tokens.

We want to tokenize our tweets, however we don’t want to lose any information. Specifically, we want to keep track of what Tweet each word came from since our analysis involves differentiating tweets. Other analyses including topic summarization may not require keeping track of this–you can just a create a jumble (i.e. “corpus”) of words and find commonalities.

In the code chunk below, we first create the dataframe text_df with the tweets_df column text and add the int column as an index for the tweets. Then, we tokenize the text data with tidytext’s unnest_tokens by using the text column as the input and word as the name of the output column. We replace text_df with this newly formatted dataframe.

unique_indices <- order(tweets_df$text)[!duplicated(sort(tweets_df$text))]

text_df <- data.frame("text" = tweets_df$text[unique_indices])
text_df$int <- as.numeric(unique_indices)
      
text_df$text <- as.character(text_df$text)


text_df <- text_df[order(text_df$int),]
row.names(text_df) <- 1:nrow(text_df)

head(text_df)

##                                                                                                                                                                                                                                                                              text
## 1                                                                                                                                                                                                  No additional abortions need to be performed to continue creating the vaccine.
## 2                                                                                                                   The cells were obtained more than years ago as a result of elective abortions and today the cells are more than three generations removed from their origin. 
## 3                                                                                                                                                                                            Sad but true. Thanks anti-vaxers #antivax #VaccinesWork #VaccinateYourKids #science 
## 4                                           Gizmo a -year-old male Rex cat came in despite the weather for his annual exam and vaccines. Great job Gizmo Good health takes priority. #rexcat #bothellpethosp #catsofinstagram #catsoftwitter #meow #vetmed #vettechs #animalspnw 
## 5 My childrens daycare director received the polio vaccine in the s. Ended up getting it as a result. She has no feeling or movement in her legs and has to use crutches. Yet.....she still requires every child to be fully vaccinated. Bc shes smart and knows death is worse. 
## 6                                                                                                                                                                                                   Deliberate disinformation is behind a massive measles outbreak in Washington 
##   int
## 1   1
## 2   2
## 3   3
## 4   4
## 5   5
## 6   7

text_df <- text_df %>%
  unnest_tokens(word, text)

head(text_df)

##     int       word
## 1     1         no
## 1.1   1 additional
## 1.2   1  abortions
## 1.3   1       need
## 1.4   1         to
## 1.5   1         be

Now that we have our data in a “tidy” format, we want to remove stop words from the text. Stop words in NLP are common words that don’t add value to a sentence, paragraph, document etc. For example, “still think the flu shot is…” doesn’t give us any extra information than “still think flu shot,” so we can remove these words to make our dataset more concise.

To do this, simply load the stop_words dataset, which has two columns: word and lexicon. There are three different lexicons that reference the source of the stop word:

• onix

• SMART

• snowball

The difference between the lexicons is they include different words. Some include more than others, thus if we use these we remove more words and from our data. To quickly see these differences, we can count the number of stop words in each category using dplyr::group_by.

data(stop_words)
head(stop_words)

## # A tibble: 6 x 2
##   word      lexicon
##   <chr>     <chr>  
## 1 a         SMART  
## 2 a's       SMART  
## 3 able      SMART  
## 4 about     SMART  
## 5 above     SMART  
## 6 according SMART

stop_words %>% 
    group_by(lexicon) %>% 
    tally()

## # A tibble: 3 x 2
##   lexicon      n
##   <chr>    <int>
## 1 onix       404
## 2 SMART      571
## 3 snowball   174

Since we have no prior reason to chose a specific lexicon, let’s remove all of the stop words in the stopwords dataset from our data using the anti_join function. We can always modify this later on.

text_df <- text_df %>%
  anti_join(stop_words %>% filter(lexicon == "snowball"))

## Joining, by = "word"

head(text_df,10)

##    int       word
## 1    1 additional
## 2    1  abortions
## 3    1       need
## 4    1  performed
## 5    1   continue
## 6    1   creating
## 7    1    vaccine
## 8    2      cells
## 9    2   obtained
## 10   2      years

Stemming

Another technique often used alongside removing stopwords is word stemming. Stemming changes each word to a root word so that different conjugations of the same word are not treated as different words completely. A human can tell that “vaccine”, vaccinate" and “vaccination” have close to the same meaning. However, for example, if we were to count every repetition of “vaccine” in R we would not get an accurate total since “vaccination” would be ignored. Instead, we change each of those words to “vaccin” with a stemming algorithm.

We will use the library SnowballC which implements the Porter stemming algorithm.

text_df_stemmed <- text_df %>%
  mutate(word = wordStem(word))
head(text_df_stemmed,10)

##    int    word
## 1    1   addit
## 2    1   abort
## 3    1    need
## 4    1 perform
## 5    1 continu
## 6    1   creat
## 7    1  vaccin
## 8    2    cell
## 9    2  obtain
## 10   2    year

Since we’ve filtered and removed the most common english words, let us also remove the most uncommon words in our dataset. This helps reduce the size of our data and remove meaningless words.

temp <- text_df_stemmed %>%dplyr::count(word)
head(temp)

## # A tibble: 6 x 2
##   word         n
##   <chr>    <int>
## 1 ""          29
## 2 a.m          2
## 3 a.schiff     1
## 4 aaa          1
## 5 aaasmtg      1
## 6 aah          1

uncomm_words <- temp %>% filter(n == 1) %>% select(word)
uncomm_words

## # A tibble: 2,302 x 1
##    word       
##    <chr>      
##  1 a.schiff   
##  2 aaa        
##  3 aaasmtg    
##  4 aah        
##  5 aapi       
##  6 abound     
##  7 abovemajest
##  8 abstract   
##  9 absurd     
## 10 abt        
## # ... with 2,292 more rows

text_df_stemmed_common <- text_df_stemmed %>%
  anti_join(uncomm_words)

## Joining, by = "word"

nrow(text_df_stemmed)

## [1] 23216

nrow(text_df_stemmed_common)

## [1] 20914

Map visual

For a fun visual, we can visualize our tweets on a map. First let’s find which tweets use the word or hashtag “antivax” and which tweets say “vaccines work.” Next we add the column Hashtags that contains labels for if the tweet contains these words or contains neither.

anti_lst <- as.numeric(
  grepl("antivax", tweets_df$text))
pro_lst <-as.numeric(
  grepl("vaccines work", tweets_df$text))

head(anti_lst)

## [1] 0 0 1 0 0 0

tweets_df$Hashtags <- "none"
tweets_df$Hashtags[anti_lst == 1] <- "#antivax"
tweets_df$Hashtags[pro_lst == 1] <- "vaccines work"

Next we use ggplot2 and ggmap to plot this on a map.

states <- map_data("state")

ggplot(data = states) + 
  geom_point(data = tweets_df, aes(x = lng, y = lat,  colour = Hashtags), size = 1) +
  geom_polygon(aes(x = long, y = lat, group=group), fill = NA, color = "dark grey") +
  theme_void()

## Warning: Removed 4933 rows containing missing values (geom_point).

As we can there was sum missing data. This is expected since most people probably don’t have their location turned on on twitter. We calculate exactly what percentage of tweets do not have an associated latitude and longitude below.

sum(is.na(tweets_df$lat) ==FALSE)/dim(tweets_df)[1]*100

## [1] 1.34

N-grams

A common NLP data exploration practice is looking at n-gram frequencies. N-grams are sequences of n items/tokens. Common n-grams that are used in NLP are unigrams, bigrams, and trigrams, meaning one word, two word, and three word combinations.

We find the top 10 most common words or unigrams to see common topics in our data. Recall that we have already removed stopwords and unnecessary items such as web links, and we have stemmed the remaining words.

unigram_count <- text_df_stemmed %>% dplyr::count(word, sort = TRUE)
head(unigram_count,20)

## # A tibble: 20 x 2
##    word         n
##    <chr>    <int>
##  1 vaccin    1726
##  2 measl      312
##  3 get        241
##  4 peopl      165
##  5 kid        160
##  6 anti       152
##  7 caus       142
##  8 on         131
##  9 diseas     129
## 10 autism     128
## 11 just       126
## 12 can        124
## 13 year       117
## 14 like       106
## 15 children    97
## 16 flu         97
## 17 immun       89
## 18 know        89
## 19 make        87
## 20 parent      85

We can graph the unigram frequencies with ggplot for a nice visualization of our text data. We pick a number of appearances to filter smaller than the total tweets we have (5,000) to plot only the top few words.

unigram_count %>%
  filter(n>100) %>%
  mutate(word = reorder(word, n)) %>%
  ggplot(aes(word, n)) +
  geom_col() +
  xlab(NULL) +
  ylab(NULL) +
  coord_flip()

Next, we can look at common bigrams, which are two words in a row. The tidytext function unnest_tokens is an efficient way to find bigrams by setting token = "ngrams" and n = 2. The output column is named “bigram”.

To get the most frequent bigrams we can simply use the dplyr library’s count function again.

bigrams_stemmed <- text_df_stemmed %>%
  unnest_tokens(bigram, word, token = "ngrams", n = 2)

head(bigrams_stemmed)

##   int          bigram
## 1   1     addit abort
## 2   1      abort need
## 3   1    need perform
## 4   1 perform continu
## 5   1   continu creat
## 6   1    creat vaccin

head(bigrams_stemmed %>%
  dplyr::count(bigram, sort = TRUE),10)

## # A tibble: 10 x 2
##    bigram             n
##    <chr>          <int>
##  1 anti vaccin       75
##  2 vaccin caus       69
##  3 measl vaccin      65
##  4 caus autism       60
##  5 get vaccin        58
##  6 flu vaccin        42
##  7 anti vaxxer       32
##  8 measl outbreak    32
##  9 chicken pox       31
## 10 mmr vaccin        28

Last in this section, a fun exploration graphic of unigrams is a “word cloud.” We can create this data visualization easily with the wordcloud2.

unigram_count %>%
  with(wordcloud(word, n, max.words = 100))

Sentiment

We want to classify the tweets by sentiment, or rather by the feelings and emotions portrayed by the user. As humans we can easily tell if someone is angry, sad, satisfied, or even sarcastic. However we have to give the computer some clues on how to do this start with the sentiments dataset which is loaded with the tidytext library. Similar to the stop_words dataset, there are three lexicons:

• afinn gives each word an integer score between -5 and 5, from most negative to most positive sentiment.

• bing gives a binary “negative” or “positive” sentiment to each words.

• nrc assigns sentiment labels of “positive, negative, anger, anticipation, disgust, fear, joy, sadness, surprise, and trust.”

We can also use the tidytext’s get_sentiments() function to only get data from a particular lexicon.

head(sentiments)

## # A tibble: 6 x 4
##   word      sentiment lexicon score
##   <chr>     <chr>     <chr>   <int>
## 1 abacus    trust     nrc        NA
## 2 abandon   fear      nrc        NA
## 3 abandon   negative  nrc        NA
## 4 abandon   sadness   nrc        NA
## 5 abandoned anger     nrc        NA
## 6 abandoned fear      nrc        NA

head(get_sentiments('afinn'))

## # A tibble: 6 x 2
##   word       score
##   <chr>      <int>
## 1 abandon       -2
## 2 abandoned     -2
## 3 abandons      -2
## 4 abducted      -2
## 5 abduction     -2
## 6 abductions    -2

“How were these sentiment lexicons put together and validated? They were constructed via either crowdsourcing (using, for example, Amazon Mechanical Turk) or by the labor of one of the authors, and were validated using some combination of crowdsourcing again, restaurant or movie reviews, or Twitter data. Given this information, we may hesitate to apply these sentiment lexicons to styles of text dramatically different from what they were validated on, such as narrative fiction from 200 years ago. While it is true that using these sentiment lexicons with, for example, Jane Austen’s novels may give us less accurate results than with tweets sent by a contemporary writer, we still can measure the sentiment content for words that are shared across the lexicon and the text.” (note to self)

Next let’s merge some of our data with the sentiment lexicon “afinn” to explore our text.

nrc_example <- get_sentiments("afinn") %>% 
  filter(score == -2)

head(text_df %>%
  inner_join(nrc_example) %>%
  dplyr::count(word, sort = TRUE),10)

## Joining, by = "word"

## # A tibble: 10 x 2
##    word               n
##    <chr>          <int>
##  1 flu               97
##  2 risk              47
##  3 death             31
##  4 wrong             25
##  5 stupid            22
##  6 injury            21
##  7 misinformation    20
##  8 sick              19
##  9 problem           16
## 10 fear              14

We note that sentiment analysis would not be straight-forward. From the text printed above, we can’t exactly pinpoint if the user is being negative about vaccinations, or the effects of not getting vaccinated, or just being negative about the anti-vaccination or vaccination communities.

Let’s plot the average afinn scores for each tweet to explore the overall sentiment of our data.

library(tidyr)
head(text_df)

##   int       word
## 1   1 additional
## 2   1  abortions
## 3   1       need
## 4   1  performed
## 5   1   continue
## 6   1   creating

tweet_sentiment <- text_df %>%
  inner_join(get_sentiments("afinn")) %>%
  dplyr::group_by(int) %>%
  dplyr::mutate(text = paste0(word)) %>%
  dplyr::summarize(sentiment_mean = mean(score))

tweet_sentiment_ordered <- tweet_sentiment[order(tweet_sentiment$sentiment_mean),] 

tweet_sentiment_ordered$int <- factor(tweet_sentiment_ordered$int, levels = tweet_sentiment_ordered$int)

ggplot(tweet_sentiment_ordered, aes(sentiment_mean)) +
  geom_histogram(show.legend = FALSE, binwidth = .3) +
  ggtitle("Mean afinn sentiment score per tweet") + 
  geom_vline(xintercept = 0, linetype = "dashed", colour = "red") +
  ylab(NULL)

 # #facet_wrap(~book, ncol = 2, scales = "free_x")

Remember when we said we should consider the negation issue? As in, how can we distinguish between the sentiment of “not like” and “like”?

Let’s print out some positive tweets. We can use the index column “int” that we’ve kept constant to print out the original (sans and Twitter handles) tweets.

positive <- tweet_sentiment$int[tweet_sentiment$sentiment_mean > 2]
head(tweets_df$text[positive])

## [1] "Gizmo a -year-old male Rex cat came in despite the weather for his annual exam and vaccines. Great job Gizmo Good health takes priority. #rexcat #bothellpethosp #catsofinstagram #catsoftwitter #meow #vetmed #vettechs #animalspnw "
## [2] "Not a fan of vaccines but I would have let him do it."                                                                                                                                                                                
## [3] "Mandated vaccines are only good for shareholders. Take that to third world countries where it is needed."                                                                                                                             
## [4] "Amen. You definitely are Perhaps go back to college and learn. I wish you the best of luck."                                                                                                                                          
## [5] "My mom is translating my grandfather's diary and we just learned that my great-grandfather passed away from tetanus in rural Iran. #VaccinesWork"                                                                                     
## [6] "SOTU on HIV a Great Start...Here's What Really Needs to Happen "

And let’s look at some negative ones as well..

negative <- tweet_sentiment$int[tweet_sentiment$sentiment_mean < -2 ]
head(tweets_df$text[negative])

## [1] "- million children died every year from Measles before the vaccine. "                                                                                                                                                                                    
## [2] "He's talking about killing - percent of people if his vaccine programs do really well. "                                                                                                                                                                 
## [3] "If you dont believe in #vaccination delete me. Cause Ill tear you apart with fucking science #vaccinate #VaccinateYourKids #science #vaccineswork #youreanidiot"                                                                                         
## [4] "People are sitting in jail for shaken baby convictions when the reality is that most of those cases are vaccine injury being covered up. Pharma continues to take lives even when it isnt directly related to their products. Doesnt that piss you off? "
## [5] "Or how about billion in damages paid out by the vaccine court? Does that count?"                                                                                                                                                                         
## [6] "Hey What the hell did I miss. Vaccines aren't one size fits all. They are harming and killing babies. It is happening. "

Neither the positive nore negative tweets are unanimously on either side of this “issue”, even with this small sample of text. Now we can really see how this won’t be easy!

We should think about what we can do about the words that won’t be found in the sentiments dataset, like “#vaccineswork” that might give us even more information about whether or not the tweet is supporting vaccines or not.

Sentiment may be just a small part of clustering tweets as “pro-vaccination” or “anti-vaccination.”

http://www.public.asu.edu/~huanliu/papers/sbp14.pdf

Topic Modeling

Since our data is unsupervised, meaning we don’t have any prior knowledge or labels to tell us if a tweet is pro or anti vaccine, we want to use topic modeling to seperate the tweets into the two sides using only the text.

Latent Dirichlet allocation (LDA) is common topic modeling method: it views each document (or in our case, each tweet) as a mixture of topics, and each topic as a combination of words. A word can be part of multiple topics, thus allowing some overlap.

In order to apply LDA, we need to take our cleaned and “tidy” text data text_df and turn it into a document term matrix (DTM). It is easy to convert from the tidy text format to this matrix. First, we add a column counting the number of word repeats per tweet.

dtm_df <- text_df_stemmed_common %>%
  group_by(int, word) %>%
  tally()

head(dtm_df)

## # A tibble: 6 x 3
## # Groups:   int [1]
##     int word        n
##   <dbl> <chr>   <int>
## 1     1 abort       1
## 2     1 addit       1
## 3     1 continu     1
## 4     1 creat       1
## 5     1 need        1
## 6     1 vaccin      1

Next, we simply use the command tidytext::cast_dtm to convert to a document term matrix, a structure where each row is a document and each column is a word.

(text_dtm <- dtm_df %>%
  cast_dtm(int, word, n))

## <<DocumentTermMatrix (documents: 1496, terms: 2066)>>
## Non-/sparse entries: 19261/3071475
## Sparsity           : 99%
## Maximal term length: 23
## Weighting          : term frequency (tf)

head(Terms(text_dtm))

## [1] "abort"   "addit"   "continu" "creat"   "need"    "vaccin"

head(Docs(text_dtm))

## [1] "1" "2" "3" "4" "5" "7"

Now we are ready to apply LDA to our DTM. We set k=2 because we are trying to create two categories of tweets: pro and anti vaccination. However, we should consider trying 3 categories later, the third being “other” tweets that are irrelevant to the debate. Note that we have no control over whether these will be the two or three clear categories, but it is the goal we are trying to achieve.

We also set an arbitrary seed to ensure we recreate the same results each time we run the code.

(lda_k2 <- LDA(text_dtm, k = 2))#, #control = list(seed = 1234)))

## A LDA_VEM topic model with 2 topics.

Now that we have our model results, we must do some exploring in order to interpret them.

As mentioned previously, each word can be in multiple topics. To examine the probability that a certain word belongs to one of the topics, we can retrieve the “beta” values. This can be done easily by providing the function tidy our topic model.

topics_k2 <- tidy(lda_k2, matrix = "beta")
head(topics_k2)

## # A tibble: 6 x 3
##   topic term         beta
##   <int> <chr>       <dbl>
## 1     1 abort   0.00103  
## 2     2 abort   0.0000247
## 3     1 addit   0.0000712
## 4     2 addit   0.000503 
## 5     1 continu 0.000779 
## 6     2 continu 0.000368

Notice this dataframe is again in the “tidy” format with one word/topic per row.

We can plot the most probable words for each topic by first creating a dataframe with the top 15 words for each topic.

Then we sort by the top terms and plot the data with ggplot2. In this case we filter by topic to show the differences.

top_terms <- topics_k2 %>%
  group_by(topic) %>%
  top_n(10, beta) %>%
  ungroup() %>%
  arrange(topic, beta)

top_terms %>%
  mutate(term = reorder(term, beta)) %>%
  ggplot(aes(term, beta, fill = factor(topic))) +
  geom_col(show.legend = TRUE) +
  coord_flip()

Some words overlap in each topic, but this is okay (and even good) because we know words such as “vaccine” can be used by both sides of this debate.

To look at the most polarizing words, i.e. words with the greatest difference between the beta values for topic 1 and 2 we can take the log ratio. We filter the topics_k2 tidy dataframe to only have common words by setting topic_x > .001.

beta_spread <- topics_k2 %>%
  mutate(topic = paste0("topic_", topic)) %>%
  spread(topic, beta) %>%
  filter(topic_1 > .001 | topic_2 > .001) %>%
  mutate(log_ratio = log2(topic_1 / topic_2))

head(beta_spread,10)

## # A tibble: 10 x 4
##    term      topic_1   topic_2 log_ratio
##    <chr>       <dbl>     <dbl>     <dbl>
##  1 ""       0.000573 0.00220      -1.94 
##  2 abort    0.00103  0.0000247     5.38 
##  3 actual   0.00103  0.00328      -1.67 
##  4 advers   0.000380 0.00115      -1.60 
##  5 advic    0.00110  0.0000469     4.55 
##  6 ag       0.000560 0.00164      -1.55 
##  7 also     0.00296  0.00239       0.310
##  8 anti     0.000283 0.0143       -5.66 
##  9 antivax  0.00446  0.00165       1.43 
## 10 antivaxx 0.00136  0.000548      1.31

Next we filter the log ratio to display just a few common terms with the largest differences between beta values. Note that since our log ratio is \(log(\frac{topic_1}{topic_2})\), if the beta value for topic 1 is larger, the log ratio will be positive. Again this means that the particular word is more likely to fall in topic 1 instead of 2. The reverse is true (if \(\beta_{t2} > \beta_{t1}\), then the log is negative).

beta_spread %>% 
  filter(log_ratio > 4.5 | log_ratio< -4.5) %>%
  mutate(term = reorder(term, log_ratio)) %>%
  ggplot(aes(term, log_ratio)) +
  geom_col(show.legend = FALSE) +
  coord_flip()

Examine group probabilities by tweet

Now that we have examined the beta values, or probability a word is in each topic, we now look at the gamma \((\gamma)\) probabilities or “per-document-per-topic probabilities.”

We create a new dataframe using tidy() again and observe how it is arranged: for each topic and document combination (for this dataset, each document is a tweet), there is a gamma value between 0 and 1.

Next, we look at the tweets with the most extreme \(\gamma\) values to get a sense of what we are working with.

lda_tweets <- tidy(lda_k2, matrix = "gamma")
head(lda_tweets)

## # A tibble: 6 x 3
##   document topic gamma
##   <chr>    <int> <dbl>
## 1 1            1 0.509
## 2 2            1 0.512
## 3 3            1 0.491
## 4 4            1 0.519
## 5 5            1 0.523
## 6 7            1 0.501

lda_tweets<-lda_tweets %>% arrange(desc(gamma))
head(lda_tweets)

## # A tibble: 6 x 3
##   document topic gamma
##   <chr>    <int> <dbl>
## 1 976          2 0.554
## 2 923          1 0.549
## 3 899          2 0.543
## 4 218          1 0.543
## 5 754          1 0.540
## 6 1046         1 0.539

This doesn’t tell us that much until we actually read the tweets in relation to their assigned topics.

Let’s print the 20 tweets with the largest \(\gamma\) scores,meaning they are the most skewed towards one topic or the other. We do this using the kableExtra library to make the twitter text nice and readable. We can also add a scroll_box to make a window that can be scrolled through when this file is knit to a HTML file.

diff_tweets<-tweets_df$text[as.numeric(lda_tweets$document[1:20])]

diff_tweets<-data.frame(diff_tweets)
diff_tweets$topic <- as.numeric(lda_tweets$topic[1:20])

kable(diff_tweets) %>%
  kable_styling("striped", full_width = F) %>%
  scroll_box(width = "750px", height = "300px")

It’s not obvious that there is a distinct difference between the two topic categories. In fact, there are some tweets that are clearly pro-vaccination in topic 2 but I also see some that are clearly anti-vaccination. This may be because this kind of topic modeling only looks at individual words such as “vaccine,” and not at bigrams or trigrams such as “vaccines work” and “vaccines cause autism.”

So let’s run a similar analysis but instead of starting with the one-token-per-row format, we start with the bigrams dataframe we created earlier. Take a look at the dataframe we just used for our analysis compared to bigrams:

head(text_df_stemmed_common)

##   int    word
## 1   1   addit
## 2   1   abort
## 3   1    need
## 4   1 continu
## 5   1   creat
## 6   1  vaccin

head(bigrams_stemmed)

##   int          bigram
## 1   1     addit abort
## 2   1      abort need
## 3   1    need perform
## 4   1 perform continu
## 5   1   continu creat
## 6   1    creat vaccin

The format is quite similar. Let’s proceed in converting bigrams to a document term matric (DTM).

dtm_bigram_df <- bigrams_stemmed %>%
  group_by(int, bigram) %>%
  tally()

head(dtm_bigram_df)

## # A tibble: 6 x 3
## # Groups:   int [1]
##     int bigram              n
##   <dbl> <chr>           <int>
## 1     1 abort need          1
## 2     1 addit abort         1
## 3     1 continu creat       1
## 4     1 creat vaccin        1
## 5     1 need perform        1
## 6     1 perform continu     1

(bigram_dtm <- dtm_bigram_df %>%
  cast_dtm(int, bigram, n))

## <<DocumentTermMatrix (documents: 1490, terms: 17508)>>
## Non-/sparse entries: 21515/26065405
## Sparsity           : 100%
## Maximal term length: 188
## Weighting          : term frequency (tf)

head(terms <- Terms(bigram_dtm))

## [1] "abort need"      "addit abort"     "continu creat"   "creat vaccin"   
## [5] "need perform"    "perform continu"

Now we apply LDA to this DTM as before.

This time, let’s try using k = 3 to see if we can capture the following three topics:

• Anti-Vaccination
• Pro-Vaccination
• Irrelvant/No Opinion

(lda_bi_k3 <- LDA(bigram_dtm, k = 3, control = list(seed = 1234)))

## A LDA_VEM topic model with 3 topics.

We get the beta values as before.

bigram_beta <- tidy(lda_bi_k3, matrix = "beta")
head(bigram_beta)

## # A tibble: 6 x 3
##   topic term             beta
##   <int> <chr>           <dbl>
## 1     1 abort need  2.74e-177
## 2     2 abort need  1.33e-177
## 3     3 abort need  1.39e-  4
## 4     1 addit abort 2.64e-177
## 5     2 addit abort 1.69e-179
## 6     3 addit abort 1.39e-  4

bigram_gamma <- tidy(lda_bi_k3, matrix = "gamma")
bigram_gamma<-bigram_gamma %>% arrange(desc(gamma))
head(bigram_gamma)

## # A tibble: 6 x 3
##   document topic gamma
##   <chr>    <int> <dbl>
## 1 121          3 0.999
## 2 102          1 0.999
## 3 4733         2 0.999
## 4 4880         3 0.999
## 5 494          2 0.999
## 6 4918         2 0.998

Wow! These \(\gamma\) values are much higher than when we used unigrams and 2 topics. Let’s read the tweets to see how it did.

diff_tweets<-tweets_df$text[as.numeric(bigram_gamma$document[1:20])]

diff_tweets<-data.frame(diff_tweets)
diff_tweets$topic <- as.numeric(bigram_gamma$topic[1:20])

kable(diff_tweets) %>%
  kable_styling("striped", full_width = F) %>%
  scroll_box(width = "750px", height = "300px")

Social network analysis

Assuming that, with high probability, users do not change their views (especially within a 7-day window) we can label Twitter users and represent them as a social network to help classify tweets.

To do this, we will use the power of retweets. We use Retweets because we can assume that if a user retweets another users tweets about vaccination, they probably agree with their opinion. This assumption gets stronger as the social network grows more connections.

We will build a network using the igraph package. This network will have users as nodes or vertices, with an edge between two vertices if the users retweet the same tweet, are following or are friends with the other user, or retweeted a tweet directly from the other user. The weight of the edge will increase if more than one of the previous are true.

First, we should create a data frame where the first two columns are vertices with an edge between them.

add attributes if there are multiple connections necessary.

tweets_df <- tweets_df %>% 
  mutate(tweet_factor = 
           as.numeric(factor(text)) )

l <- list()

for (i in c(1:max(tweets_df$tweet_factor))){
  users <- unique(c(tweets_df$uuidgens_user[tweets_df$tweet_factor==i],
                    tweets_df$uuidgens_retweet[tweets_df$tweet_factor==i]))
  users <- users[is.na(users) == FALSE]
  l <- append(l, list(users))
}

Now we have each tweet on the list with the associated users. Now let’s create an edge between all these users by creating the dataframe that will be converted to a graph object with igraph.

graph_df <- matrix(ncol=2, nrow=400000)
index = 1

for (i in c(1:length(l))){
  if (length(l[[i]]) > 1){
    combos <- t(combn(l[[i]],2))
    graph_df[c(index:(index + length(combos[,1])-1)),] <- combos
    
    index = index + length(combos[,1]) 
  }
}

graph_df <- as.data.frame(graph_df)

Let’s delete the extra room

graph_df<-graph_df[is.na(graph_df$V1) == FALSE,]
dim(graph_df)

## [1] 338563      2

head(graph_df)

##                                     V1
## 1 cc8eeb70-22e2-434d-b45c-6b97a9190f74
## 2 2f298d4f-7624-4579-913c-df9345faec9d
## 3 02ada9a6-b938-4b53-89f4-ceff5ae37332
## 4 966a2f43-2259-45e1-ab42-2a0d786d0aab
## 5 73801492-b2c5-453a-ba60-2e658bb1dc1c
## 6 3028f322-b26d-4302-a186-70f08984785f
##                                     V2
## 1 78539956-fdeb-4ce2-af5e-e208c37860ef
## 2 3e3e2c54-e0c1-4c63-853c-9d7dff34e4f3
## 3 c3190ff6-a315-4a34-9ac2-71d9ad682dc2
## 4 d41967c5-4113-48bf-917c-f6fa28301083
## 5 dfd3cfd2-5903-488c-a565-fc401a8802f2
## 6 dfd3cfd2-5903-488c-a565-fc401a8802f2

So now we’ve connect each user to all of its tweets, and each unique tweet to all unique users that retweeted it.

graph_df$V1 <-as.character(graph_df$V1)
graph_df$V2 <-as.character(graph_df$V2)

graph_df <- graph_df %>%
  group_by(V1,V2) %>%
  tally()

dim(graph_df)

## [1] 334279      3

#df1 <- data.frame(t(apply(graph_df[1:2], 1, sort)), graph_df[3])
#df1 <- aggregate(n~., df1, FUN=sum)

vtx_df <- data.frame("unique_vtcs" = unique(c(graph_df$V1, graph_df$V2)))
head(vtx_df)

##                            unique_vtcs
## 1 001af1ba-15fc-4459-9bfd-588051d71c42
## 2 00427d72-d1e9-4259-a354-1ccf3c9a82fa
## 3 0074fbbe-d9a1-47c9-a29d-d9aa826e0e03
## 4 00a3282d-9bc7-4fca-aafc-3e3e875d2bdd
## 5 00a7aa13-08cc-4d8e-8575-3f975f3547db
## 6 00c77f8c-2448-4112-9ac0-81f3908bae53

Set remaining vertices to -1 so they are ignored (initialized vertices)

g <- graph_from_data_frame(d = graph_df, directed = FALSE, vertices = vtx_df)
edge_width <- (E(g)$n)**2

Run label propagation, Add vertex attributes and color the largest communities.

clp <- cluster_label_prop(g, weights = edge_width)#, fixed = vtx_df$fix)

# create some vertex attributes
V(g)$community <- clp$membership
head(E(g)$n)

## [1] 1 1 1 1 1 1

#V(g)$betweenness <- betweenness(g, v = V(g), directed = F)
#V(g)$degree <- degree(g, v = V(g))

Data visualization: color the largest communities.

data <- toVisNetworkData(g)
nodes <- data[[1]]
edges <- data[[2]]

edge_width <- (E(g)$n)**2

library(RColorBrewer)

get_big_coms <- nodes %>% 
  select(community) %>% 
  group_by(community) %>% 
  tally() %>%
  arrange(desc(n))

biggest_groups<- get_big_coms$community[1:2]

col <- rep("grey", length(V(g)))
colors<- brewer.pal(10, "Paired")

for(j in c(1:2)){
  col[V(g)$community == biggest_groups[j]] <- colors[j]
}

Now that we have created all the labels we can display the graph with graphjs.

graphjs(g, vertex.color = col,  vertex.size = .3,  edge.width = edge_width, na.ok = TRUE)

## Warning in graphjs(g, vertex.color = col, vertex.size = 0.3, edge.width =
## edge_width, : mulitple edge widths not yet supported